home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 021-030 / amok28 / turtle / turtle.mod < prev    next >
Text File  |  1993-11-04  |  8KB  |  313 lines

  1. (*---------------------------------------------------------------------------
  2.     :Program.    Turtle.mod
  3.     :Author.     Manfred Weigl
  4.     :Address.    Mitteldorf 17, D-8435-Dietfurt
  5.     :Phone.      08464/417
  6.     :History.    V1.0, 05-aug-89
  7.     :Copyright.  PD
  8.     :Language.   Modula-II
  9.     :Translator. M2Amiga
  10.     :Contents.   PROCEDUREs für die Turtlegrafik
  11. ---------------------------------------------------------------------------*)
  12.  
  13.  
  14. IMPLEMENTATION MODULE Turtle;
  15.  
  16.  
  17. FROM SYSTEM    IMPORT ADR, FFP;
  18. FROM Graphics  IMPORT RastPortPtr, Draw, Move, SetAPen, Text, WritePixel,
  19.                       ReadPixel, DrawModes, DrawModeSet, SetDrMd;
  20. FROM Intuition IMPORT ScreenPtr, WindowPtr;
  21. FROM MathTrans IMPORT Sin, Cos;
  22. FROM Strings   IMPORT Length;
  23.  
  24.  
  25. VAR
  26.   Turtle : RECORD
  27.              x, y       : FFP;
  28.              heading,
  29.              color,
  30.              size       : INTEGER;
  31.              pendown,
  32.              showturtle : BOOLEAN;
  33.              rp         : RastPortPtr;
  34.            END;
  35.  
  36.  
  37.  
  38. (*********   Private Prozeduren, nicht zum importieren bestimmt   *********)
  39.  
  40.  
  41.   PROCEDURE rad (a : INTEGER) : FFP;
  42.     BEGIN
  43.       RETURN FFP(a) * 3.14159265/180.0;
  44.     END rad;
  45.  
  46.   PROCEDURE int (x : FFP) : INTEGER;
  47.     BEGIN
  48.       RETURN INTEGER(x+0.5);
  49.     END int;
  50.  
  51.   PROCEDURE DrawTurtle;
  52.     BEGIN
  53.       IF Turtle.showturtle THEN
  54.         SetDrMd(Turtle.rp, DrawModeSet{complement});
  55.         SetAPen(Turtle.rp, Turtle.color);
  56.         Move(Turtle.rp, int(Turtle.x), int(Turtle.y));
  57.         Draw(Turtle.rp,
  58.              int(Turtle.x + FFP(Turtle.size) * Sin(rad(Turtle.heading))),
  59.              int(Turtle.y - FFP(Turtle.size) * Cos(rad(Turtle.heading))));
  60.         Draw(Turtle.rp,
  61.              int(Turtle.x + FFP(Turtle.size) * Sin(rad(Turtle.heading+120))),
  62.              int(Turtle.y - FFP(Turtle.size) * Cos(rad(Turtle.heading+120))));
  63.         Draw(Turtle.rp,
  64.              int(Turtle.x + FFP(Turtle.size) * Sin(rad(Turtle.heading+240))),
  65.              int(Turtle.y - FFP(Turtle.size) * Cos(rad(Turtle.heading+240))));
  66.         Draw(Turtle.rp,
  67.              int(Turtle.x + FFP(Turtle.size) * Sin(rad(Turtle.heading))),
  68.              int(Turtle.y - FFP(Turtle.size) * Cos(rad(Turtle.heading))));
  69.         SetDrMd(Turtle.rp, DrawModeSet{});
  70.       END;
  71.     END DrawTurtle;
  72.  
  73.  
  74. (*********      aber jetzt gehts los mit der Turtlegrafik        *********)
  75.  
  76.  
  77. PROCEDURE InitTurtle (rp : RastPortPtr);
  78.   BEGIN
  79.     Turtle.x          := 0.0;
  80.     Turtle.y          := 0.0;
  81.     Turtle.heading    := 0;
  82.     Turtle.color      := 1;
  83.     Turtle.size       := 10;
  84.     Turtle.pendown    := TRUE;
  85.     Turtle.showturtle := TRUE;
  86.     Turtle.rp         := rp;
  87.     DrawTurtle;
  88.   END InitTurtle;
  89.  
  90. PROCEDURE InitTurtleScr (sp : ScreenPtr);
  91.   BEGIN
  92.     InitTurtle(ADR(sp^.rastPort));
  93.   END InitTurtleScr;
  94.  
  95. PROCEDURE InitTurtleWin (wp : WindowPtr);
  96.   BEGIN
  97.     InitTurtle(wp^.rPort);
  98.   END InitTurtleWin;
  99.  
  100. PROCEDURE Home;
  101.   BEGIN
  102.     DrawTurtle;
  103.     IF Turtle.pendown THEN
  104.       SetAPen (Turtle.rp, Turtle.color);
  105.       Move (Turtle.rp, int(Turtle.x), int(Turtle.y));
  106.       Draw (Turtle.rp, 0, 0);
  107.     END;
  108.     Turtle.x := 0.0;
  109.     Turtle.y := 0.0;
  110.     Turtle.heading := 0;
  111.     DrawTurtle;
  112.   END Home;
  113.  
  114. PROCEDURE Forward (Laenge : INTEGER);
  115.   BEGIN
  116.     DrawTurtle;
  117.     IF Turtle.pendown THEN
  118.       SetAPen (Turtle.rp, Turtle.color);
  119.       Move (Turtle.rp, int(Turtle.x), int(Turtle.y));
  120.       Turtle.x := Turtle.x + FFP(Laenge) * Sin(rad(Turtle.heading));
  121.       Turtle.y := Turtle.y - FFP(Laenge) * Cos(rad(Turtle.heading));
  122.       Draw (Turtle.rp, int(Turtle.x), int(Turtle.y));
  123.     ELSE
  124.       Turtle.x := Turtle.x + FFP(Laenge) * Sin(rad(Turtle.heading));
  125.       Turtle.y := Turtle.y - FFP(Laenge) * Cos(rad(Turtle.heading));
  126.     END;
  127.     DrawTurtle;
  128.   END Forward;
  129.  
  130. PROCEDURE Back (Laenge : INTEGER);
  131.   BEGIN
  132.     DrawTurtle;
  133.     IF Turtle.pendown THEN
  134.       SetAPen (Turtle.rp, Turtle.color);
  135.       Move (Turtle.rp, int(Turtle.x), int(Turtle.y));
  136.       Turtle.x := Turtle.x - FFP(Laenge) * Sin(rad(Turtle.heading));
  137.       Turtle.y := Turtle.y + FFP(Laenge) * Cos(rad(Turtle.heading));
  138.       Draw (Turtle.rp, int(Turtle.x), int(Turtle.y));
  139.     ELSE
  140.       Turtle.x := Turtle.x - FFP(Laenge) * Sin(rad(Turtle.heading));
  141.       Turtle.y := Turtle.y + FFP(Laenge) * Cos(rad(Turtle.heading));
  142.     END;
  143.     DrawTurtle;
  144.   END Back;
  145.  
  146. PROCEDURE Left (Winkel : INTEGER);
  147.   BEGIN
  148.     DrawTurtle;
  149.     Turtle.heading := Turtle.heading - Winkel;
  150.     DrawTurtle;
  151.   END Left;
  152.  
  153. PROCEDURE Right (Winkel : INTEGER);
  154.   BEGIN
  155.     DrawTurtle;
  156.     Turtle.heading := Turtle.heading + Winkel;
  157.     DrawTurtle;
  158.   END Right;
  159.  
  160. PROCEDURE SetXY (x, y : INTEGER);
  161.   BEGIN
  162.     DrawTurtle;
  163.     IF Turtle.pendown THEN
  164.       SetAPen (Turtle.rp, Turtle.color);
  165.       Move (Turtle.rp, int(Turtle.x), int(Turtle.y));
  166.       Draw (Turtle.rp, x, y);
  167.     END;
  168.     Turtle.x := FFP(x);
  169.     Turtle.y := FFP(y);
  170.     DrawTurtle;
  171.   END SetXY;
  172.  
  173.  
  174. PROCEDURE SetHeading (Winkel : INTEGER);
  175.   BEGIN
  176.     DrawTurtle;
  177.     Turtle.heading := Winkel;
  178.     DrawTurtle;
  179.   END SetHeading;
  180.  
  181. PROCEDURE PenUp;
  182.   BEGIN
  183.     Turtle.pendown := FALSE;
  184.   END PenUp;
  185.  
  186. PROCEDURE PenDown;
  187.   BEGIN
  188.     Turtle.pendown := TRUE;
  189.   END PenDown;
  190.  
  191. PROCEDURE ShowTurtle;
  192.   BEGIN
  193.     IF NOT Turtle.showturtle THEN
  194.       Turtle.showturtle := TRUE;
  195.       DrawTurtle;
  196.     ELSE
  197.       Turtle.showturtle := TRUE;
  198.     END;
  199.   END ShowTurtle;
  200.  
  201. PROCEDURE HideTurtle;
  202.   BEGIN
  203.     DrawTurtle;
  204.     Turtle.showturtle := FALSE;
  205.   END HideTurtle;
  206.  
  207. PROCEDURE SizeTurtle(n : INTEGER);
  208.   BEGIN
  209.     DrawTurtle;
  210.     Turtle.size := n;
  211.     DrawTurtle;
  212.   END SizeTurtle;
  213.  
  214. PROCEDURE PenColor (Farbe : INTEGER);
  215.   BEGIN
  216.     Turtle.color := Farbe;
  217.   END PenColor;
  218.  
  219. PROCEDURE Plot (x, y : INTEGER);
  220.   VAR dummy : LONGINT;
  221.   BEGIN
  222.     SetAPen (Turtle.rp, Turtle.color);
  223.     dummy := WritePixel(Turtle.rp, x, y);
  224.   END Plot;
  225.  
  226. PROCEDURE PlotText (x, y : INTEGER; text : ARRAY OF CHAR);
  227.   BEGIN
  228.     SetAPen (Turtle.rp, Turtle.color);
  229.     Move (Turtle.rp, x, y);
  230.     Text (Turtle.rp, ADR(text), Length(text));
  231.   END PlotText;
  232.  
  233. PROCEDURE WriteText (text : ARRAY OF CHAR);
  234.   BEGIN
  235.     DrawTurtle;
  236.     SetAPen (Turtle.rp, Turtle.color);
  237.     Move (Turtle.rp, int(Turtle.x), int(Turtle.y));
  238.     Text (Turtle.rp, ADR(text), Length(text));
  239.     DrawTurtle;
  240.   END WriteText;
  241.  
  242. PROCEDURE DrawTo (x, y : INTEGER);
  243.   BEGIN
  244.     DrawTurtle;
  245.     SetAPen (Turtle.rp, Turtle.color);
  246.     Move (Turtle.rp, int(Turtle.x), int(Turtle.y));
  247.     Draw (Turtle.rp, x, y);
  248.     Turtle.x := FFP(x);
  249.     Turtle.y := FFP(y);
  250.     DrawTurtle;
  251.   END DrawTo;
  252.  
  253. PROCEDURE MoveTo (x, y : INTEGER);
  254.   BEGIN
  255.     DrawTurtle;
  256.     Turtle.x := FFP(x);
  257.     Turtle.y := FFP(y);
  258.     DrawTurtle;
  259.   END MoveTo;
  260.  
  261. PROCEDURE dDraw (dx, dy : INTEGER);
  262.   BEGIN
  263.     DrawTurtle;
  264.     SetAPen (Turtle.rp, Turtle.color);
  265.     Move (Turtle.rp, int(Turtle.x), int(Turtle.y));
  266.     Turtle.x := Turtle.x + FFP(dx);
  267.     Turtle.y := Turtle.y + FFP(dy);
  268.     Draw (Turtle.rp, int(Turtle.x), int(Turtle.y));
  269.     DrawTurtle;
  270.   END dDraw;
  271.  
  272. PROCEDURE dMove (dx, dy : INTEGER);
  273.   BEGIN
  274.     DrawTurtle;
  275.     Turtle.x := Turtle.x + FFP(dx);
  276.     Turtle.y := Turtle.y + FFP(dy);
  277.     DrawTurtle;
  278.   END dMove;
  279.  
  280. PROCEDURE TurtleX () : INTEGER;
  281.   BEGIN
  282.     RETURN int(Turtle.x);
  283.   END TurtleX;
  284.  
  285. PROCEDURE TurtleY () : INTEGER;
  286.   BEGIN
  287.     RETURN int(Turtle.y);
  288.   END TurtleY;
  289.  
  290. PROCEDURE TurtleHeading () : INTEGER;
  291.   BEGIN
  292.     Turtle.heading := Turtle.heading MOD 360;
  293.     RETURN Turtle.heading;
  294.   END TurtleHeading;
  295.  
  296. PROCEDURE TurtleSize () : INTEGER;
  297.   BEGIN
  298.     RETURN Turtle.size;
  299.   END TurtleSize;
  300.  
  301. PROCEDURE TurtleColor () : INTEGER;
  302.   BEGIN
  303.     RETURN Turtle.color;
  304.   END TurtleColor;
  305.  
  306. PROCEDURE GetColor (x, y : INTEGER) : INTEGER;
  307.   BEGIN
  308.     RETURN ReadPixel(Turtle.rp, x, y);
  309.   END GetColor;
  310.  
  311. END Turtle.
  312.  
  313.